perm filename JUSTFY.F4[NEW,LCS]14 blob sn#496791 filedate 1980-02-02 generic text, type T, neo UTF8
00100	C*************** SUBROUTINE JUSTFY, FUNCTION OTHSID *************
00200		SUBROUTINE JUSTFY(JLP,R,IR,NO,NP,RN,RSTFAC,R2,R4,R5,R6,R8,R9)
00300	CC	IMPLICIT INTEGER(A-Q,S-Z)
00400	CC	REAL EXTEN,PRCNT,ACCX,SPFAC
00500		COMMON /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
00600	CC	COMMON /STF/RSTFAC(0/7),RSTJ2 /JSTFY/ROV,PRCNT,RJSZ/KJY/ KY,JY
00700		DIMENSION IR(2,250),R(2,250),RN(1),NO(1),NP(1),RSTFAC(0/1)
00800		DATA RBX/6.0/,RBZ/8.0/,SPFAC/0.20/
00900	CC	DATA RSP/.5/,RI/4.5/
01000	CC	RSP=.5
01100	CCC	SPFAC=.5
01200		DO 11 KN=0,JLP
01300		RSPC=0
01400		R8=KN
01500		N=0
01600	
01700		DO 2 K=1,KY
01800		L=NP(K)
01900		RL=RN(L)
02000	C  RL=WDCNT-2
02100		RA=RN(L+1)
02200	C  RA=CODE NUM.
02300		RB=RN(L+3)
02400	C  RB=POSITION(P3)
02500		IF(RN(L+2).EQ.R8)GO TO 77
02600	C  THIS STAFF?
02700		IF(RA.NE.4)GO TO 2
02800	C  SKIPS HOMED NOTES (IN CHORDS)
02900	77	IF(RA.LT.3)GO TO 20
03000		IF(RA.EQ.4)GO TO 444
03100		IF(RA.EQ.3)GO TO 333
03200	C  LOOKS AT NOTES,RESTS,CLEFS,BAR LINES,KSIGS,METERS.
03300		IF(RA.LT.17)GO TO 2
03400		GO TO 10
03500	333	IF(RL.LT.3)GO TO 10
03600	C  <3 MEANS NOTHING IN P5
03700		IF(RN(L+5).GT.4)GO TO 2
03800	C  NOT A REAL CLEF IF >4 (0=TREB, 1=BASS, 2=ALT, 3=TEN, 4=PERC.)
03900		GO TO 10
04000	444	IF(RL.GT.3.OR.RN(L+4).LT.0)GO TO 2
04100	C IF P4.LT.0 THEN IT'S AN INVISIBLE BAR.
04200	CC  FOR REPEAT BAR WDCNT IS 3 -- 10/77 444	IF(RL.GT.2)GO TO 2
04300	C  SHOULD CHECK ON BAR LINES NO MATTER WHICH STAFF
04400		GO TO 10
04500	20	IF(RA.NE.2)GO TO 113
04600	C ASSUMES WD CNT. IS GREAT ENOUGH!?!?!?!?
04700		IF(RN(L+6))GO TO 2
04800		IF(RN(L+7))GO TO 2
04900	C SKIP INVIS. RESTS AND RESTS WITH NEG. RHYTH. (PUT THIS IN OTHER JUST. PROGS.)
05000		GO TO 10
05100	113	IF(RL.LT.7)GO TO 10
05200	C NOW NOTES.  SKIP IF NEG. VALUE IN P9 (IT'S A SUPPLEMENTAL NOTE.)
05300		IF(RN(L+9).LT.0)GO TO 2
05400	10	N=N+1
05500		R(1,N)=RB
05600		IR(2,N)=L
05700		IF(N.EQ.250)GO TO 28
05800	C  ONLY TREATS 250 ITEMS AT A TIME.
05900	2	CONTINUE
06000	
06100		IF(N.EQ.0)GO TO 11
06200	28	DO 23 K=1,N
06300	23	IF(RN(IR(2,K)+1).NE.4)GO TO 24
06400	C  SKIPS IF ONLY BAR LINES ON THIS STAFF
06500		GO TO 11
06600	24	RSZ=RSTFAC(KN)*PRCNT
06700		CALL SORT2(R,N)
06800	
06900	C  JUMP IF LAST IS A BAR LINE.
07000		K=0
07100		JLDGR=0
07200	     	JX=0
07300	22	K=K+1
07400	122	L=IR(2,K)
07500		RA=RN(L+1)
07600	C  RA IS NOW CODE NUM.
07700		RL=RN(L)
07800	C  RL=WDCNT-2
07900		RB=0
08000		RD=0
08100	C  RD WILL HOLD SPACE TO ADD TO PREV. ITEM, IF NEEDED.
08200		RX=RN(L+5)
08300	C  RX=PARAM 5
08400		RX6=RN(L+6)
08500		RY=1
08600		RW=AMOD(RN(L+4),100.)
08700		RSP=SPFAC*RSTFAC(IFIX(RN(L+2)))
08800		IF(RA.GT.1)GO TO 4
08900		RZ=RN(L+7)
09000		IF(LDGR.NE.JLDGR)JLDGR=0
09100	C CHECK FOR PRESENCE OF LEDGER LINES WITH SUCCESSIVE NOTES
09200		LDGR=0
09300		JK=K
09400		DO 32 JJ=JK+1,N+1
09500		K=JJ
09600		RB=R(1,JJ)-R(1,JJ-1)
09700		IF(RB.GT.0.1)GO TO 320
09800	C  PUTS THEM AT EXACT SAME POINT IF CLOSER THAN .1
09900		R(1,JJ)=R(1,JJ-1)
10000		GO TO 32
10100	320	IF(RB.GT.RSP)GO TO 35
10200	32	CONTINUE
10300	C  FOUND HOW MANY MEMBERS TO CHORD.
10400	35	RB=0
10500		K=K-1
10600		RQ=0
10700	125	RC=ABS(RN(L+4))
10800		
10900		IF(RC.LT.60)GO TO 637
11000		IF(RC.LT.180)RY=.6
11100	C  FOUND A MINI-NOTE
11200	
11300	637	RSDF=0
11400		IF(RA.EQ.1)GO TO 437
11500	C JUMP IF NOTE
11600		RDF=-1
11700	C NOW IT'S ANYTHING BUT A NOTE
11800		GO TO 137
11900	437	IF(RL.LT.8)GO TO 237
12000	C JUMP IF THERE IS NOT P10 TO LOOK AT
12100		RW=RN(L+10)
12200	C PUT P10 INTO RW
12300		GO TO 337
12400	237	RW=0
12500	337	IF(RDF.LT.0)GO TO 537
12600	C JUMP IF PREVIOUS WAS NOT A NOTE
12700		IF(RW.EQ.RDF)GO TO 137
12800	C SKIP TO FAR END OF LOOP IF THINGS ARE ON DIFF. STAVES. (CLEFS?, ETC?)
12900		RSDF=-1
13000	537	RDF=RW
13100	C SAVE STAFF INFO FOR NEXT TIME AROUND.
13200	
13300	137	DO 37 JJ=JK,K
13400	C*******	IF(RD.NE.0)GO TO 38
13500	C FINDS ONLY HIGH OR! LOW LED. LINE.
13600		JR=IR(2,JJ)
13700		RW=AMOD(RN(JR+4),100.)
13800		IF(RW.GT.12)GO TO 277
13900		IF(RW.GE.2)GO TO 38
14000	277	LDGR=-1
14100		IF(RW.GT.11)LDGR=1
14200		IF(JLDGR.EQ.LDGR)GO TO 36
14300		JLDGR=LDGR
14400	C LDGR IS FOR LEDGER LINES.
14500		GO TO 38
14600	36	IF(RD.GE.1.5)GO TO 38
14700		RD=1.5
14800		RQ=RD
14900	38	IF(RB.GT.2)GO TO 222
15000	C  JUMP IF LARGE SPACE AFTER NOTE IS ALREADY SET UP.
15100		RZZ=RN(JR+7)
15200		RE=RN(JR+5)
15300		IF(RB.GE.2)GO TO 477
15400		RC=1.5
15500		IF(RZZ.LT.10)GO TO 378
15600		IF(RZZ.GE.20)RC=3.
15700	C   10=DOT, 20=DOUBLE DOT
15800		GO TO 377
15900	378	IF(RE.GE.20)GO TO 477
16000		IF(AMOD(RZZ,10.).EQ.0)GO TO 477
16100	377	RB=RC+EXTEN(RZZ)
16200	C  SPACE FOR DOT OR TAIL(IF STEM UP)
16300	477	IF(ABS(RN(JR+6)).EQ.10)RB=RB+2
16400	C  FOR CHORD TONES ON RIGHT OF STEM UP.
16500	C  LOOKS THROUGH ALL NOTES OF A CHORD.
16600	222	RC=AMOD(RE,10.0)
16700		IF(RC.EQ.0)GO TO 37 
16800	C  JUMP IF NO ACCIS.  NOW SEE IF THERE'S SPACE FOR ACCI.
16900		IF(RN(JIR+1).NE.1)GO TO 425
17000	C*	RX=0
17100	C*	IF(RN(JR).GE.8)RX=RN(JR+10)
17200	C*	RXX=0
17300	C*	IF(RN(JIR).GE.8)RXX=RN(JIR+10)
17400	C*	RDF=0
17500	C*	IF(RX.NE.RXX)RDF=100.
17600	C SAVE INFO ON NOTES ON DIFF. STAVES.
17700	C*	IF(RXX.EQ.1.OR.RX.EQ.2)RDF=-RDF
17800	C**** THIS NEXT AREA PROBABLY NEEDS MORE WORK (2/78) ***********
17900	C JIR IS POINTER TO PREVIOUS ITEM.  SKIP IF NOT A NOTE.
18000		KX=RC
18100	C KX=ACCI ON CURRENT NOTE
18200		RD=1 
18300	C ADD A LITTLE SPACE FOR ACCI. ANYHOW.
18400		RX=RN(L+4)
18500		RXX=ABS(RX)
18600	C THIS NOTE
18700	577	IF(RXX.LT.80)GO TO 677
18800	C FIND MINIS, HARMONICS, ETC.
18900		RXX=RXX-100
19000		GO TO 577
19100	677	IF(RX)RXX=-RXX
19200		RX=RXX
19300		RDIF=RN(JIR+4)
19400		RXX=ABS(RDIF)
19500	777	IF(RXX.LT.80)GO TO 877
19600	C FIND MINIS, HARMONICS, ETC.
19700		RXX=RXX-100
19800		GO TO 777
19900	877	IF(RDIF)RXX=-RXX
20000	
20100		RDIF=RX-RXX
20200	C HEIGHT DIFF.  JUMP OUT IF TOO CLOSE TOGETHER. AMOD IS FOR GRACE NOTES, ETC.
20300		RX=3
20400		JSTM=RN(JIR+5)/10.0 
20500	C JSTM=STEM DIRECTION OF PREVIOUS NOTE. 1=UP, 2=DOWN
20600		IF(RDIF.GT.0)GO TO 427
20700	C JUMP IF PREV NOTE IS BELOW. LIMITS: b OR NAT.=3, #=4
20800		IF(JSTM.NE.2)GO TO 424
20900		IF(AMOD(RN(JIR+7),10.0).GE.1)GO TO 425
21000	C JUMP IF PREV. NOTE HAS STEM DOWN WITH TAIL.  THEN WE NEED SPACE.
21100	424	IF(KX.NE.2)RX=5
21200		GO TO 428
21300	427	IF(KX.EQ.2)RX=4
21400	C PREV NOTE IS ABOVE. LIMITS: b OR NAT.=5, #=3
21500	428	IF(ABS(RDIF).LT.RX)GO TO 425
21600		IF(RDIF)GO TO 426 
21700	C JUMP IF THIS NOTE IS LOWER THAN PREV.
21800		IF(JSTM.NE.1)GO TO 426 
21900	C NO  BIG SPACE NEEDED IF PREV. NOTE HAS STEM DOWN AND IS BELOW.
22000	
22100	425	RW=2.8
22200		IF(IFIX(AMOD(RE,10.0)).EQ.4)RW=4.8
22300	CATCHES DOUBLE FLAT (=4)
22400	   	RD=RW*RY+EXTEN(RE)+OTHSID(RN,JR)
22500	CGHB USE 2.8 FOR SIZE OF ACCIS (THEY'RE REALLY 3)425	RD=2*RY+EXTEN(RE)
22600	426	IF(RQ.GT.RD)RD=RQ
22700		RQ=RD
22800	C  FUNCT. EXTEN=AMOD(X,1.)*10.
22900	37 	CONTINUE
23000	
23100		IF(RY.NE.1)RB=RB-.5*RJSZ
23200	C  MINI NOTES NEED LESS SPACE
23300	250	IF(RSDF)GO TO 17
23400		ACCX=0
23500	CC	RC=0
23600	 	JIR=JX+2
23700		IF(JIR.GE.N)GO TO 25
23800		RW=R(1,JIR-1)
23900	
24000		DO 132 JJ=JIR,N  
24100		IF(RW.NE.R(1,JJ))GO TO 25
24200		KX=IR(2,JJ)
24300	C  GET POINTER
24400		IF(RN(KX+1).NE.1)GO TO 25
24500	C  ONLY CHECK ON NOTES (THIS IS FOR CHRD NOTES WITH ACCIS)
24600	CC	RE=ABS(RN(KX+6))
24700	CC	IF(RE.GE.10)RC=-2.6
24800	CC	IF(RE.EQ.20)RC=-RC
24900		RC=OTHSID(RN,KX)
25000		RE=AMOD(RN(KX+5),10.0)
25100	C  FIND AN ACCI
25200		IF(RE.GE.1)RC=RC+2
25300		IF(IFIX(RE).EQ.4)RC=RC+2
25400	C  FOUND AN ACCI    RE=4=DOUBLE FLAT
25500		RC=AMOD(RE,1.0)*10.0+RC
25600	C  ADD ANY EXTENSION TO THE LEFT
25700		IF(RC.GT.ACCX)ACCX=RC
25800	CC	RC=0
25900		IF(ACCX.GT.RD)RD=ACCX
26000	132	CONTINUE
26100		GO TO 25
26200	
26300	4	IF(RA.NE.2)GO TO 33
26400	C  NEXT FOR DOTTED RESTS - IN P6
26500		IF(RL.GE.4)RB=RN(L+6)*1.5
26600	C  NOW GO BACK TO SEE IF THERE IS A NOTE IN SAME HORIZ. POS.
26700		GO TO 250
26800	33	IF(RA.NE.3)GO TO 29
26900		RB=3
27000		IF(RN(L+4).GT.80)RB=1.5
27100	C  CHECK ON SIZE NEEDED FOR CLEFS.  >80 = MINICLEF
27200	29	IF(RA.NE.4)GO TO 26
27300	C BAR LINES
27400		IF(RN(L+4).LT.0)GO TO 17
27500	C SKIP IF INVISIBLE BAR LINE (FOR PAGE PROGRAM )
27600		RB=-RJSZ/2
27700		RD=.9
27800		KX=RN(L+4)/1000.
27900		IF(KX.LE.0.)GO TO 25
28000		RD=RD+1.2
28100	C  ADD A LITTLE SPACE IN FRONT OF DBL BAR.
28150		IF(KX.GT.1)GO TO 229
28200		IF(RL.LT.3)GO TO 25
28250	C JUMP IF THIN DBL BAR. OLD DBL BAR HAS 1 IN P5.
28300	CCC	IF(KX.EQ.1.OR.KX.EQ.3)RD=RD+RD
28350	229	IF(KX.NE.2)RD=RD+RD
28375	C 2=DOTS TO RT. 1 OR 4=DOTS TO LFT. 3=DOTS ON BOTH SIDES.
28400	C  REPT BAR WITH DOTS TO LEFT.  ADD SPACE IN FRONT OF IT.
28500		RB=-RB/RBX
28550		IF(KX.EQ.4)KX=0
28600	129	IF(KX.GE.2)RB=RBZ*RB
28700	C  IF DOTS TO RIGHT ADD MORE SPACE AFTER REPT BAR.
28800		GO TO 25
28900	
29000	26	IF(RA.NE.18)GO TO 30
29100	C METER
29200		RC=0
29300		IF(RL.GE.7)RC=9
29400	C FOR COMPOSITE METERS. NO CHECK FOR DBL DIGITS YET.
29500		RB=-1
29600		RD=1
29700		IF(RX6.LE.9.AND.RX.LE.9)GO TO 31
29800	C  CHECKS FOR 2-DIGIT METERS
29900		RD=2
30000		RB=0
30100	31	RB=RB+RC
30200		GO TO 25
30300	30	IF(RA.NE.17)GO TO 17
30400	C KSIG
30500		RX=ABS(RX)
30600		IF(RX.GE.100)RX=RX-100
30700	C  +100 FOR NATURALS AS KEYSIG.
30800		RB=2*(RX-1)-2
30900	C  SPACES FOR CORRECT NUM OF ACCIS.  RX=NUM OF ACCIS.
31000		RD=2
31100	25	IF(JX.GT.0)R(2,JX)=R(2,JX)+RD*RSZ
31200	17	RC=(RB+RJSZ)*RSZ
31300	C  RJSZ=DEFAULT SIZE
31400		JIR=L
31500	C SAVE THE POINTER FOR ACCI. CHECK AT 110
31600		JX=K
31700		R(2,JX)=RC
31800	3	IF(K.LT.N)GO TO 22
31900		RA=R(1,1)
32000		RB=R(2,1)
32100	
32200		DO 13 KX=2,JX
32300		RE=R(1,KX)
32400	C  POS. BEFORE SHIFTING
32500		IF(ABS(RE-RA).GT.RSP)GO TO 14
32600	CCC	IF(ABS(RE-RA).GT..5)GO TO 14
32700		IF(R(2,KX).GT.RB)GO TO 16
32800	C  SKIPS DOUBLE STOPS AND VERY CLOSE ITEMS
32900		GO TO 13
33000	C  JUMP WHEN SPACE TO ADD IS SMALLER THAN WHAT'S ALREADY THERE
33100	14	RD=RA+RB-RE
33200		IF(RD.LE.0)GO TO 16
33300	C  THERE'S ENOUGH ROOM
33400		ROV=ROV+RD
33500	140	R4=RE+RSPC-.001
33600		R5=10000
33700		R8=RD
33800		R9=0
33900	C  GO EXPAND IT
34000		IF(R(2,KX).EQ.0)GO TO 15
34100		CALL MOVIT(RN,NO,R4,R5,R8,R9)
34200	C????	IF(R2.LE.4)GO TO 15
34300	C SKIP NEXT IF COMING FROM 'PAGE' OR 'JUST'
34400		IF(R2.LE.7)GO TO 15
34500		R5=R4
34600		R4=RA+.001+RSPC
34700		R8=R4
34800		R9=R5+RD-.001
34900	C  FOR ITEMS ON OTHER LINES.
35000		CALL MOVIT(RN,NO,R4,R5,R8,R9)
35100	15	RSPC=RSPC+RD
35200	C  RSPC SAVES TOTAL SPACE ADDED
35300	16	RB=R(2,KX)
35400	13	RA=RE
35500	11	CONTINUE
35600		END
35700	
35800		FUNCTION OTHSID(RN,J)
35900		DIMENSION RN(1)
36000		OTHSID=0
36100		A=ABS(RN(J+6))
36200		IF(A.GE.10)OTHSID=-2.6
36300	C  OTHSID=SPACE NEEDED (+ OR -) BECAUSE OF NOTE ON 'WRONG' SIDE OF STEM.
36400		IF(A.GE.20)OTHSID=-OTHSID
36500		END